home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / timetrak / ttrakpxg.bas < prev   
BASIC Source File  |  1995-09-06  |  15KB  |  344 lines
  1. '******* Declarations for Using the Paradox 3.5 Engine ******
  2. Declare Function PXWinInit Lib "Pxengwin.dll" (ByVal Application$, ByVal Mode%) As Integer
  3. Declare Function PXExit Lib "Pxengwin.dll" () As Integer
  4. '************ TABLE FUNCTIONS *****************
  5. Declare Function PXTblOpen Lib "Pxengwin.dll" (ByVal TblName$, TblHnd%, ByVal index%, ByVal change%) As Integer
  6. Declare Function PXTblClose Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  7. '************* RECORD FUNCTIONS *******************
  8. Declare Function PXRecAppend Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  9. Declare Function PXRecInsert Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  10. Declare Function PXRecUpdate Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  11. Declare Function PXRecDelete Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  12. Declare Function PXRecBufOpen Lib "Pxengwin.dll" (ByVal TblHnd%, RecHnd%) As Integer
  13. Declare Function PXRecBufClose Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  14. Declare Function PXRecBufEmpty Lib "Pxengwin.dll" (ByVal RecHnd%) As Integer
  15. Declare Function PXRecGet Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%) As Integer
  16. Declare Function PXRecFirst Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  17. Declare Function PXRecNext Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  18. Declare Function PXRecPrev Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  19. Declare Function PXRecNum Lib "Pxengwin.dll" (ByVal TblHnd%, RecNum%) As Integer
  20. Declare Function PXTblNRecs Lib "Pxengwin.dll" (ByVal TblHnd%, nRecs%) As Integer
  21. '**************** FIELD FUNCTIONS ****************
  22. Declare Function PXPutShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal sValue%) As Integer
  23. Declare Function PXPutDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal dValue#) As Integer
  24. Declare Function PXPutLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal lValue&) As Integer
  25. Declare Function PXPutAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal aValue$) As Integer
  26. Declare Function PXPutBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%) As Integer
  27. Declare Function PXPutDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal inDate As Any) As Integer
  28. Declare Function PXGetShort Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, sValue%) As Integer
  29. Declare Function PXGetDoub Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, dValue#) As Integer
  30. Declare Function PXGetLong Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, lValue&) As Integer
  31. Declare Function PXGetAlpha Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal bufSize%, ByVal aValue$) As Integer
  32. Declare Function PXFldBlank Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, ByVal Blank%) As Integer
  33. Declare Function PXGetDate Lib "Pxengwin.dll" (ByVal RecHnd%, ByVal FldHnd%, outDate As Any) As Integer
  34. Declare Function PXRecNFlds Lib "Pxengwin.dll" (ByVal TblHnd%, nFlds%) As Integer
  35. Declare Function PXFldHandle Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldName$, FldHnd%) As Integer
  36. Declare Function PXFldType Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal fldtype$) As Integer
  37. Declare Function PXFldName Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal FldHnd%, ByVal BufSiz%, ByVal FldName$) As Integer
  38. '*************** SEARCH FUNCTIONS *******************
  39. Declare Function PXSrchKey Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal nFlds%, ByVal Mode%) As Integer
  40. Declare Function PXSrchFld Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal RecHnd%, ByVal FldNum%, ByVal Mode%) As Integer
  41. '***************** MISCELLANEOUS FUNCTIONS ****************
  42. Declare Function PXDateDecode Lib "Pxengwin.dll" (ByVal outDate As Any, mm%, dd%, yy%) As Integer
  43. Declare Function PXDateEncode Lib "Pxengwin.dll" (ByVal mm%, ByVal dd%, ByVal yy%, pDate&) As Integer
  44. '******************* NETWORK FUNCTIONS ******************
  45. Declare Function PXNetUserName Lib "Pxengwin.dll" (ByVal buffer%, UserName$) As Integer
  46. Declare Function PXNetFileLock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  47. Declare Function PXNetFileUnlock Lib "Pxengwin.dll" (ByVal FileName$, ByVal lockType%) As Integer
  48. Declare Function PXNetTblLock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  49. Declare Function PXNetTblUnlock Lib "Pxengwin.dll" (ByVal TblHnd%, ByVal lockType%) As Integer
  50. Declare Function PXNetRecLock Lib "Pxengwin.dll" (ByVal TblHnd%, LockHnd%) As Integer
  51. Declare Function PXNetRecLocked Lib "Pxengwin.dll" (ByVal TblHnd%, Locked%) As Integer
  52. Declare Function PXNetTblChanged Lib "Pxengwin.dll" (ByVal TblHnd%, Changed%) As Integer
  53. Declare Function PXNetTblRefresh Lib "Pxengwin.dll" (ByVal TblHnd%) As Integer
  54.  
  55. Function Gen_Date (vDate As String)
  56.     pos1% = InStr(1, vDate, "/")
  57.     mm = Val(Mid$(vDate, 1, pos1% - 1))
  58.     pos2% = InStr(pos1% + 1, vDate, "/")
  59.     dd = Val(Mid$(vDate, pos1% + 1, pos2% - pos1% - 1))
  60.     temp$ = Mid$(vDate, pos2% + 1, 4)
  61.     If Len(temp$) = 4 Then
  62.         yy = Val(Mid$(temp$, 3, 2))
  63.     Else
  64.         yy = Val(temp$)
  65.     End If
  66.     If (mm < 1 Or mm > 12 Or dd < 1 Or yy < 1) Then
  67.         eflag% = 1
  68.     ElseIf mm = 2 And dd > 28 Then
  69.         eflag% = 1
  70.     ElseIf (mm = 4 Or 6 Or 9 Or 11) And dd > 30 Then
  71.         eflag% = 1
  72.     ElseIf dd > 31 Then
  73.         eflag% = 1
  74.     End If
  75.     If eflag% = 1 Then
  76.         Gen_Date = 1
  77.     Else
  78.         Gen_Date = 0
  79.         rc = PXDateEncode(mm, dd, yy, lValue)
  80.     End If
  81. End Function
  82.  
  83. Sub GetField (RecHnd%, FldHnd%, fldtype$)
  84.     returnFld = ""
  85.     aValue = ""
  86.     lValue = 0
  87.     dValue = 0
  88.     Select Case Mid$(fldtype$, 1, 1)
  89.         Case Is = "A"
  90.             rc = PXGetAlpha(RecHnd%, FldHnd%, 255, aValue)
  91.             PXError
  92.             returnFld = aValue
  93.         Case Is = "N"
  94.             rc = PXGetLong(RecHnd%, FldHnd%, lValue)
  95.             PXError
  96. '            If lValue < 0 Then
  97. '                lValue = 0
  98. '            End If
  99.             returnFld = Format$(lValue, "###0")
  100.         Case Is = "$"
  101.             rc = PXGetDoub(RecHnd%, FldHnd%, dValue)
  102.             PXError
  103. '            If dValue < 0 Then
  104. '                dValue = 0
  105. '            End If
  106.             returnFld = Format$(dValue, "###,##0.00")
  107.         Case Is = "D"
  108.             rc = PXGetDate(RecHnd%, FldHnd%, lValue)
  109.             PXError
  110.             rc = PXDateDecode(lValue, mm, dd, yy)
  111.             returnFld = LTrim$(Str$(mm)) + "/" + LTrim$(Str$(dd)) + "/" + LTrim$(Str$(yy))
  112.     End Select
  113.  
  114. End Sub
  115.  
  116. Sub PutField (RecHnd%, FldHnd%, fldtype$)
  117.     Select Case Mid$(fldtype$, 1, 1)
  118.         Case Is = "A"
  119.             rc = PXPutAlpha(RecHnd%, FldHnd%, aValue)
  120.             PXError
  121.         Case Is = "N"
  122.             rc = PXPutBlank(RecHnd%, FldHnd%)
  123.             PXError
  124.             rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  125.             PXError
  126.         Case Is = "$"
  127.             rc = PXPutBlank(RecHnd%, FldHnd%)
  128.             PXError
  129. '           rc = PXPutLong(RecHnd%, FldHnd%, lValue)
  130.             rc = PXPutDoub(RecHnd%, FldHnd%, dValue)
  131.             PXError
  132.         Case Is = "D"
  133.             rc = PXPutDate(RecHnd%, FldHnd%, lValue)
  134.             PXError
  135.     End Select
  136.  
  137. End Sub
  138.  
  139. Sub PXError ()
  140.     Dim msgbuf As String
  141.     If rc = 0 Then
  142.         Exit Sub
  143.     End If
  144. '   msgbuff = Code + "=" + Str$(rc)
  145. '   msgbuff = PXErrMsg(rc)
  146.     Select Case rc
  147.         Case Is = NOT_PROGRAMMED
  148.             msgbuf = " Code Not Finished"
  149.         Case Is = PXERR_NOTINITERR
  150.             msgbuf = " Engine not initialized"
  151.         Case Is = PXERR_ALREADYINIT
  152.             msgbuf = "Engine already initialized"
  153.         Case Is = PXERR_NOTLOGGEDIN
  154.             msgbuf = " Could not log onto network"
  155.         Case Is = PXERR_NONETINIT
  156.             msgbuf = " Engine not initialized"
  157.         Case Is = PXERR_NETMULTIPLE
  158.             msgbuf = " multiple PARADOX.NET files"
  159.         Case Is = PXERR_CANTSHAREPDOXNET
  160.             msgbuf = " can't lock PARADOX.NET-is SHARE.EXE loaded?"
  161.         Case Is = PXERR_WINDOWSREALMODE
  162.             msgbuf = " can't run Engine in Windows real mode"
  163.         Case Is = PXERR_DRIVENOTREADY
  164.             msgbuf = " Drive not ready"